home *** CD-ROM | disk | FTP | other *** search
/ El Mac 9 / El Mac 9.iso / Shareware / Applications / MathPad 2.4 / XFuns / XFun kit / histogram src / histoppc.c < prev   
Encoding:
C/C++ Source or Header  |  1996-03-26  |  1.9 KB  |  78 lines  |  [TEXT/CWIE]
  1. /* An example of an XFun that operates on arrays.
  2.    Accumulates a histogram given an array of values.
  3.    PowerPC version. The project includes the 68K version as a resource*/
  4.  
  5. #include "callbackg.h"
  6. #include <CodeFragments.h>
  7.  
  8. /* Fragment initialization entry point. Must match symbol name in linker prefs */
  9. OSErr InitCFun(CFragInitBlockPtr iblk);
  10.  
  11. static short histogram(double *retval)
  12. {
  13.    EXPR arr;
  14.    double *iptr,*bins,num,binlo,binhi,scl;
  15.    long ndata,i,nbins;
  16.    double sum;
  17.    short isarray;
  18.  
  19.    if(!GetParmVal(2,&binlo)) return(FALSE);
  20.    if(!GetParmVal(1,&binhi)) return(FALSE);
  21.    if(!GetParmVal(0,&num)) return(FALSE);
  22.    nbins = num;
  23.    if(nbins <= 0 || binlo == binhi)
  24.    {
  25.     ErrMsg(" illegal parameter value",0L);
  26.     return(FALSE);
  27.    }
  28.    
  29.    MakeParmExpr(3,&arr);
  30.    ProbeExpr(arr,&num,&isarray,&ndata);
  31.    if(!isarray || !ndata)        /* expecting a finite array */
  32.    {
  33.     ErrMsg(" histogram(?,…) array size?",0);
  34.     FreeExpr(arr);
  35.     return(FALSE);
  36.    }
  37.  
  38.    scl = nbins/(binhi-binlo);
  39.    bins = (double *)NewPtrClear(nbins*sizeof(double));
  40.    if(!bins)
  41.    {
  42.     ErrMsg(" not enough memory",0);
  43.     FreeExpr(arr);
  44.     return(FALSE);
  45.    }
  46.    
  47.    AddIndex(&arr,&iptr);
  48.    
  49.    sum = 0;
  50.    *retval = 0;
  51.    *iptr = 1;
  52.    while(ndata--)
  53.    {
  54.     if(EvalExpr(arr,&num))        /* evaluate arr[*iptr] */
  55.     {
  56.      i = (num-binlo)*scl;
  57.      if(i>=0 && i<nbins)
  58.      {
  59.       bins[i] += 1;
  60.       *retval += 1;                /* function return value is total points within range */
  61.       sum += num;
  62.      }
  63.     }
  64.     *iptr += 1;
  65.     if(Stopped()) break;            /* exit loop if problems */
  66.    }
  67.    FreeExpr(arr);
  68.    SetVarMatrix("bins",bins,nbins,0);    /* return histogram in global array "bins" */
  69.    SetVarVal("mean",sum / *retval);        /* return mean in global "mean" */
  70.    return(TRUE);
  71. }
  72.  
  73. OSErr InitCFun(CFragInitBlockPtr iblk)
  74. {
  75.    AddCFun("histogram","array,lo,hi,nbins",&histogram,NULL);
  76.    return noErr;
  77. }
  78.